Outputs inspection half CIFAR100

library(ggplot2)
library(dplyr)
library(tidyr)
library("ggpubr")
library(LDATS)
library(ggVennDiagram)
library(stringr)
library(abind)

source("utils.R")

Visualization on CIFAR100. We are using data of three neural networks trained on reduced CIFAR100 training set. Half of the CIFAR100 training set was extracted as a validation set. We then divided both the reduced training set and validation set into 5 disjoint subsets and trained an ensemble on each of them. This was done in 10 replications, each time with random split of the training set into validation and new training set. In this visualization, we are trying to inspect the outputs deeper, mainly to make sense of strange behavior of nll metric for ensemble outputs.

base_dir <- "../data/data_train_val_half_c100"
repls <- 0:9
folds <- 0:4
classes <- 100

nets_outputs <- load_network_outputs(base_dir, repls)
ens_outputs <- load_ensemble_outputs(base_dir, repls, folds, gather=(1 + nets_outputs$test_labels[1, ]))

sort_ind <- function(lst)
{
  return(sort(lst, index.return=TRUE, decreasing=TRUE)$ix)
}
nets_test_top_indices <- apply(X=nets_outputs$test_outputs, MARGIN=c(1, 2, 3), FUN=sort_ind)[1, , , ]
r_n <- length(repls)
samples_n <- dim(nets_outputs$test_labels)[2]
nets_n <- length(nets_outputs$networks)
test_labs <- nets_outputs$test_labels + 1
dim(test_labs) <- c(r_n, 1, samples_n)
test_labs <- aperm(abind(array(rep(aperm(test_labs, perm=c(2, 1, 3)), nets_n), c(r_n, samples_n, nets_n)), along=3), perm=c(1, 3, 2))
nets_test_cor_preds <- test_labs == nets_test_top_indices

for (ri in 1:r_n)
{
  nets_cor_list <- list()
  incor <- 1:samples_n
  for (ni in 1:nets_n)
  {
    cor_list <- which(nets_test_cor_preds[ri, ni, ])
    nets_cor_list[[nets_outputs$networks[ni]]] = cor_list
    incor <- setdiff(incor, cor_list)
  }
  incor_n <- length(incor)
  venn_diag <- ggVennDiagram(nets_cor_list) + scale_fill_gradient(trans="log10", name="count", limits=c(1, 10000)) +
    annotate(geom="text", x=-4, y=5, label=paste("Incorrect ", incor_n, "\n", round(incor_n / samples_n * 100), "%")) +
    ggtitle(paste("Correct predictions by network - replication ", ri)) +
    scale_x_continuous(limits=c(-8, 10))
  print(venn_diag)
}

Compared to CIFAR10 examples, here are fewer samples correctly classified by all the networks. For one network exclusive correct classifications densenet and xception perform better than resnet. Pairs of network all have similar values with xception, resnet lagging a bit.

preds <- nets_outputs$test_outputs
for (ri in repls + 1)
{
  for (net_i in seq_along(nets_outputs[["networks"]]))
  {
    preds[ri, net_i, ,] <- softmax(preds[ri, net_i, , ])
  }
}
nets_test_cor_probs <- gather(preds, 1 + nets_outputs$test_labels[1, ], 3, 4)
nets_test_cor_probs <- melt(nets_test_cor_probs)
nets_test_cor_probs <- nets_test_cor_probs[, c(-3, -4)]
names(nets_test_cor_probs) <- c("replication", "network", "prediction")
nets_test_cor_probs$network <- as.factor(nets_test_cor_probs$network)
levels(nets_test_cor_probs$network) <- nets_outputs$networks

nets_cor_preds_histo <- ggplot(data=nets_test_cor_probs) + geom_histogram(mapping=aes(x=prediction), binwidth=0.01) +
  ggtitle("Histograms of predicted probability for the correct class") + facet_wrap(~network) + scale_y_log10()
nets_cor_preds_histo

levels(val_ens_cor_probs$combining_method) <- ens_outputs$combining_methods

Error: object 'ens_outputs' not found

val_ens_cor_preds_histo <- ggplot(data=val_ens_cor_probs) + geom_histogram(mapping=aes(x=prediction), binwidth=0.01) + facet_grid(rows=vars(combining_method), cols=vars(coupling_method)) + scale_y_log10() + ggtitle("Probabilities predicted for the correct class - ens trained on val")
val_ens_cor_preds_histo

sum(val_ens_cor_probs$prediction <= 0)

[1] 0

No zero probabilities produced

train_ens_cor_preds_histo <- ggplot(data=train_ens_cor_probs) + geom_histogram(mapping=aes(x=prediction), binwidth=0.01) + facet_grid(rows=vars(combining_method), cols=vars(coupling_method)) + scale_y_log10() + ggtitle("Probabilities predicted for the correct class - ens trained on train")
train_ens_cor_preds_histo

Warning: Transformation introduced infinite values in continuous y-axis
Warning: Removed 63 rows containing missing values (geom_bar).

Strange behavior observed for bc coupling method in case of combining method lda is not present for combining methods logreg.

train_ens_zero_counts <- ggplot(data=train_ens_cor_probs[train_ens_cor_probs$prediction <= 0, ]) + geom_histogram(mapping=aes(x=coupling_method), stat="count") + facet_wrap(~combining_method)  + ggtitle("Counts of zero or lower probabilities predicted for the correct class by coup m\nTrain training")

Warning: Ignoring unknown parameters: binwidth, bins, pad

train_ens_zero_counts

m2_iter and bc didn’t produce any zero probability outputs. Neither were there any zero probability outputs for combining method logistic regression.

val_ens_nll <- ggplot(data=ens_results) + geom_boxplot(mapping=aes(x=coupling_method, y=nll)) + facet_grid(cols=vars(train_set), rows=vars(combining_method)) +
  ggtitle("Comparison of nll for coupling methods for different combiner train methodologies")
val_ens_nll

val_ens_cor_probs$train_type <- "vt"
train_ens_cor_probs$train_type <- "tt"
ens_cor_probs <- rbind(val_ens_cor_probs, train_ens_cor_probs)

ens_cor_preds_histo <- ggplot(data=ens_cor_probs) + geom_histogram(mapping=aes(x=prediction), binwidth=0.01) + facet_grid(rows=vars(combining_method, coupling_method), cols=vars(train_type)) + scale_y_log10() + ggtitle("Probabilities predicted for the correct class")
ens_cor_preds_histo

Warning: Transformation introduced infinite values in continuous y-axis
Warning: Removed 63 rows containing missing values (geom_bar).

In case of logreg combining method there are fewer values in the extreme bins than for lda. Also, there are fewer of these extreme values for tt than for vt.

df_val_Rs <- melt(np$load(file.path(base_dir, "val_training_class_aggr_R.npy")))
df_train_Rs <- melt(np$load(file.path(base_dir, "train_training_class_aggr_R.npy")))
co_m_R <- read.csv(file.path(base_dir, "R_mat_co_m_names.csv"), header=FALSE)

names(df_val_Rs) <- c("combining_method", "precision", "class", "class1", "class2", "prob")
names(df_train_Rs) <- c("combining_method", "precision", "class", "class1", "class2", "prob")

df_val_Rs[,c("class", "class1", "class2", "combining_method")] <- lapply(df_val_Rs[,c("class", "class1", "class2", "combining_method")], as.factor)
df_train_Rs[,c("class", "class1", "class2", "combining_method")] <- lapply(df_train_Rs[,c("class", "class1", "class2", "combining_method")], as.factor)

levels(df_val_Rs$combining_method) <- co_m_R$V1
levels(df_train_Rs$combining_method) <- co_m_R$V1

df_val_Rs$train_type <- "vt"
df_train_Rs$train_type <- "tt"
class_mean_Rs <- rbind(df_val_Rs, df_train_Rs)

df_aggr_Rs_diff <- class_mean_Rs %>% pivot_wider(names_from = train_type, values_from = prob) %>% mutate(val_min_train = vt - tt)

for (cls in 1:classes)
{
  cur_class_Rs <- class_mean_Rs %>% filter(class == cls)
  plot_cls <-  ggplot(cur_class_Rs, aes(x = class2, y = class1)) + 
    geom_raster(aes(fill=prob)) + 
    facet_grid(rows=vars(combining_method), cols=vars(train_type)) +
    scale_fill_gradient(low="grey90", high="red", limits=c(0, 1)) +
    scale_y_discrete(limits=rev, breaks=seq(1, 100, 10)) +
    scale_x_discrete(breaks=seq(1, 100, 10)) +
    labs(x="class 2", y="class 1", title=paste("Average pairwise probabilities - class ", cls)) +
    theme_bw()
  
  print(plot_cls)
}

matrices for logreg are less sharp - this is visible mainly for tt.

for (cls in 1:classes)
{
  cur_class_Rs <- df_aggr_Rs_diff %>% filter(class == cls)
  plot_cls <-  ggplot(cur_class_Rs, aes(x = class2, y = class1)) + 
    geom_raster(aes(fill=val_min_train)) + 
    facet_wrap(~combining_method) +
    scale_fill_binned(type="viridis", limits=c(-0.3, 0.3), name="validation minus training") +
    scale_y_discrete(limits=rev, breaks=seq(1, 100, 10)) +
    scale_x_discrete(breaks=seq(1, 100, 10)) +
    labs(x="class 2", y="class 1", title=paste("Differences between average pairwise probabilities - class ", cls)) +
    theme_bw()
  
  print(plot_cls)
}

Logistic regression without intercept has lower differences between tt and vt R matrices than other combining methods.

combiner_coefs <- load_combiner_coefs(base_dir, repls, folds)

for (cl1 in 1:(10 - 1))
{
  for (cl2 in (cl1 + 1):10)
  {
    cur_plt <- combiner_coefs %>% filter(class1 == cl1 & class2 == cl2) %>% ggplot() + geom_boxplot(aes(x=coefficient, y=value)) +
      facet_grid(cols=vars(train_type), rows=vars(combining_method)) + ggtitle(paste("Coefficients for class", cl1, "vs", cl2))
    print(cur_plt)
  }
}

for (cl1 in 1:(10 - 1))
{
  for (cl2 in (cl1 + 1):10)
  {
    cur_plt <- combiner_coefs %>% filter(class1 == cl1 & class2 == cl2 & combining_method!="lda") %>% ggplot() + geom_boxplot(aes(x=coefficient, y=value)) +
      facet_grid(cols=vars(train_type), rows=vars(combining_method)) + ggtitle(paste("Coefficients for class", cl1, "vs", cl2))
    print(cur_plt)
  }
}

In case of lda train_training coefficients tend to have higher variance, in case of logreg it seem to be the oposite, val_training coefficients have higher variance.

avg_combiner_coefs <- combiner_coefs %>% filter(coefficient != "interc") %>% group_by(class1, class2, precision, train_type, coefficient, combining_method) %>% summarise( value = mean(value)) %>% ungroup()

`summarise()` has grouped output by 'class1', 'class2', 'precision', 'train_type', 'coefficient'. You can override using the `.groups` argument.

avg_combiner_c_w <- pivot_wider(avg_combiner_coefs, names_from = coefficient, values_from = value)
avg_combiner_c_w[, c("class1", "class2")] <- lapply(avg_combiner_c_w[, c("class1", "class2")], as.factor)
avg_combiner_c_w$top_net <- factor(c("densenet121", "resnet34", "xception")[max.col(as.matrix(avg_combiner_c_w[, c("densenet121", "resnet34", "xception")]))])

coefs_grid <- ggplot(avg_combiner_c_w, aes(x=class2, y=class1, fill=top_net)) + 
  geom_raster() + 
  scale_fill_brewer(type="qual") +
  facet_grid(cols=vars(train_type), rows=vars(combining_method)) +
  scale_y_discrete(limits=rev, breaks=seq(0, 100, 10)) +
  scale_x_discrete(breaks=seq(0, 100, 10)) +
  guides(fill=guide_legend(title="Network")) +
  xlab("Class") + 
  ylab("Class") +
  ggtitle("Network with highest lda weight for class pairs") +
  theme(plot.title = element_text(hjust = 0.5),
        axis.ticks = element_blank(),
        panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank())

coefs_grid